perm filename X4.FAI[TMP,LCS] blob
sn#133869 filedate 1974-12-04 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00010 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE X
C00003 00003 BEG: SETOM LINE
C00012 00004 MVLFT: SUB C,YY
C00018 00005 FNF: PUSHJ P,DETCHK
C00021 00006 FRD: MOVSI A,'DMD'
C00023 00007 GETNAM: MOVEI A,
C00024 00008 XINI: OUTSTR [ASCIZ /TOTAL LENGTH IN INCHES (Y DIMENSION, DEFAULT = 11)?/]
C00027 00009 XGPOUT: OPEN XGP,[1017↔'XGP '↔0]
C00031 00010 FILNAM: 0
C00032 ENDMK
C⊗;
TITLE X
A←1
B←2
C←3
D←4
E←5
L←6
U←7
PEN←10
X←11
Y←12
XD←13
T←15
TT←16
P←17
LPDL←←69
DSK←←1
XGP←←2
LMAR←←=0
RMAR←←=1699
WIDTH←←=1700
LBUFL←←=48
LSTBIT←←1⊗34
OVERLAP←←=50 ;OVERLAP 1/4 INCH
BOTTOM←←=50 ;SHIFT BOTTOM UP 1/4 INCH
DOFF←←-=760
NBUFS←←4
EXTERN JOBREL,JOBFF
MAILBF: BLOCK 40
SIGN: 0
LINE: 0
PNTR: 0
BEG: SETOM LINE
GETLIN LINE ;FOR ERROR PRINTOUT
CALLI
HRRZS LINE ;CLEAR LINE BITS
MOVE P,[-LPDL,,PDL-1]
FILIN: OUTSTR [ASCIZ /FILE? (DEFAULT IS PLT.DMD) /]
PUSHJ P,FRD
SETZ A,
YAGN1: HRREI B,-60
OUTSTR [ASCIZ/ORIGIN X OFFSET FROM SIDE (DEFAULT IS 4(CENTER))?/]
PUSHJ P,RNUM
JRST [ HRREI A,-=760
JRST YDEF]
IMULI A,=100
CAIN C,"." ;DECIMAL POINT?
JRST [ INCHWL C
CAIN C,15
INCHWL C
CAIL C,"0"
CAILE C,"9"
JRST .+1
SUBI C,60
IMULI C,=10
SKIPE SIGN
MOVN C,C
ADD A,C
PUSH P,A
PUSHJ P,RNUM ;JUST GOBBLE THE REST
JFCL
POP P,A
JRST .+1]
MOVN A,A
LSH A,1 ;*2 (MAKE IT STEPS)
YDEFP: CAIE C,12
JRST [ CLRBFI
JRST YAGN1]
YDEF: ADD A,B
MOVNM A,INIX#
AGAIN: MOVE A,[FILNAM,,LKENT]
BLT A,LKENT+3
OPEN DSK,[14↔'DSK '↔IBUF]
JRST 4,.
INBUF DSK,NBUFS
LOOKUP DSK,LKENT
JRST FNF
ASKLEN: SETZM POOB#
PUSHJ P,XINI
JRST CORLUZ
SETZM XX#
SETZM YY#
MOVEI C,3
HRRZM C,PENN#
OUTER: IN DSK,
JRST PLOT
STATO DSK,20000
JRST 4,.
RELEAS DSK,
IFN LSTBIT-1,<PUSHJ P,XFIX>
JRST XGPOUT
PLOT: HRR C,IBUF+1
MOVN E,1(C)
MOVSI E,(E)
HRR E,IBUF+1
PLOT1: MOVE 14,2(E)
JUMPE 14,ENOUT
LSHC 14,-10
ASH 15,-34
MOVEM 15,SVPEN#
MOVMS 15
CAIE 15,1
HRRM 15,PENN
HRR 15,PENN
CAIN 15,3
JRST PENUP
LSHC 14,-16
ASH 15,-26
MOVE C,15
MOVEM C,SVY#
SUB 15,YY
IMULI 15,LBUFL+1
ADD 15,Y
CAIGE 15,(L)
JRST LOSE
CAIL 15,-LBUFL-1(U)
JRST LOSE
LSHC 14,-16
ASH 15,-26
MOVE 0,15
MOVEM 0,SVX#
IORM B,@X
SUB 0,XX
JUMPE NORMX
JUMPL MVLFT
SUB C,YY
JUMPE C,NRT
JUMPL C,MVDWN
MOVMS C
MOVMS 0
CAMLE C,0
JRST XCHA
SETZ 14,
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
INLOOP: ADD 15,C
TLZE 15,200000
ADDI Y,LBUFL+1
SKIPGE B
XCT XMOVU(X)
DOI1: ROT B,1
IORM B,@X
SOJG INLOOP
JRST DONXT
AOJ A,
XMOVU: HRLOI X,XD
REPEAT LBUFL-1,<SOJ X,>
SOJL A,.+1
MOVE X,[Y,,LBUFL-1]
AOJA A,DOI1
PENUP: LSHC 14,-16
ASH 15,-26
MOVEM 15,SVY
SUB 15,YY
IMULI 15,LBUFL+1
ADD Y,15
LOBAC: LSHC 14,-16
ASH 15,-26
MOVEM 15,SVX
SUB 15,XX
JUMPE 15,DONXT
JUMPL 15,PULFT
CAIGE 15,44
JRST XLOOP
IDIVI 15,44
XCT XVVVV(X)
XXXX: SOJG 15,.-1
HRR 15,16
XLOOP: SOJL 15,DONXT
SKIPGE B
XCT XZZZZ(X)
XLLL: ROT B,1
JRST XLOOP
AOJ A,
XVVVV: HRLOI X,XD
REPEAT LBUFL-1,<SOJ X,>
SOJL A,.+1
MOVE X,[Y,,LBUFL-1]
AOJA A,XXXX
AOJ A,
XZZZZ: HRLOI X,XD
REPEAT LBUFL-1,<SOJ X,>
SOJL A,.+1
MOVE X,[Y,,LBUFL-1]
AOJA A,XLLL
PULFT: MOVMS 15
CAIGE 15,44
JRST OOO
IDIVI 15,44
XCT SBXX(X)
KOOP: SOJG 15,.-1
HRR 15,16
OOO: SOJL 15,DONXT
ROT B,-1
JUMPGE B,OOO
XCT SBZZ(X)
JRST OOO
SOJL A,XYZ
SBXX: REPEAT LBUFL-1,<AOJ X,>
MOVE X,[XD,,LBUFL]
AOJ A,
XYZ: MOVSI X,Y
AOJA A,KOOP
SOJL A,ZYX
SBZZ: REPEAT LBUFL-1,<AOJ X,>
MOVE X,[XD,,LBUFL]
AOJ A,
ZYX: MOVSI X,Y
AOJA A,OOO
XCHA: EXCH C,0
SETZ 14,
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
INLOO: ADD 15,C
TLZN 15,200000
JRST MVUP
SKIPGE B
XCT XMOV(X)
DOI3: ROT B,1
MVUP: ADDI Y,LBUFL+1
IORM B,@X
SOJG INLOO
JRST DONXT
AOJ A,
XMOV: HRLOI X,XD
REPEAT LBUFL-1,<SOJ X,>
SOJL A,.+1
MOVE X,[Y,,LBUFL-1]
AOJA A,DOI3
MVDWN: MOVMS C
MOVMS 0
CAMLE C,0
JRST XCHA2
SETZ 14,
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
INLOP: ADD 15,C
TLZE 15,200000
SUBI Y,LBUFL+1
SKIPGE B
XCT XMOVD(X)
DOO1: ROT B,1
IORM B,@X
SOJG INLOP
JRST DONXT
AOJ A,
XMOVD: HRLOI X,XD
REPEAT LBUFL-1,<SOJ X,>
SOJL A,.+1
MOVE X,[Y,,LBUFL-1]
AOJA A,DOO1
XCHA2: EXCH 0,C
SETZ 14,
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
INOOP: ADD 15,C
TLZN 15,200000
JRST MVEX
SKIPGE B
XCT XMVEX(X)
DOO4: ROT B,1
MVEX: SUBI Y,LBUFL+1
IORM B,@X
SOJG INOOP
JRST DONXT
AOJ A,
XMVEX: HRLOI X,XD
REPEAT LBUFL-1,<SOJ X,>
SOJL A,.+1
MOVE X,[Y,,LBUFL-1]
AOJA A,DOO4
NRT: MOVE 15,0
POOP: JUMPL B,GOOP
TOOT: ROT B,1
IORM B,@X
SOJG 15,POOP
JRST DONXT
GOOP: SOJ X,
CAIGE 15,44
JRST TOOT
IDIVI 15,44
SETOM @X
SOJ X,
SOJG 15,.-2
HRR 15,16
JUMPN 15,TOOT
AOJ X,
JRST DONXT
SOJL A,XYXY
SBBB: REPEAT LBUFL-1,<AOJ X,>
MOVE X,[XD,,LBUFL]
AOJ A,
XYXY: MOVSI X,Y
AOJA A,ZYZY
SOJL A,XYY
XTTT: REPEAT LBUFL-1,<AOJ X,>
MOVE X,[XD,,LBUFL]
AOJ A,
XYY: MOVSI X,Y
AOJA A,XUUU
NLFT: MOVM 15,0
ROT B,-1
JUMPL B,ROOT
WOOP: IORM B,@X
SOJG 15,.-3
JRST DONXT
ROOT: XCT SBBB(X)
ZYZY: CAIGE 15,44
JRST WOOP
IDIVI 15,44
SETOM @X
XCT XTTT(X)
XUUU: SOJG 15,.-2
HRR 15,16
JUMPN 15,WOOP
SOJ X,
ROT B,1
JRST DONXT
NORMX: SUB C,YY
JUMPE C,NOMOVE
JUMPL C,MDOWN
MUP: ADDI Y,LBUFL+1
IORM B,@X
SOJG C,MUP
JRST DONXT
MDOWN: SUBI Y,LBUFL+1
IORM B,@X
AOJL C,MDOWN
DONXT: MOVE 4,SVX
MOVEM 4,XX
MOVE 4,SVY
MOVEM 4,YY
NOMOVE: SKIPL SVPEN
JRST ENOUT
SETZM XX
SETZM YY
ENOUT: AOBJN E,PLOT1
JRST OUTER
MVLFT: SUB C,YY
JUMPE C,NLFT
JUMPL C,MVLD
MOVMS C
MOVMS 0
CAMLE C,0
JRST XCHA3
SETZ 14,
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
ILOOP: ADD 15,C
TLZE 15,200000
ADDI Y,LBUFL+1
ROT B,-1
SKIPGE B
XCT XMOVR(X)
DOPEN: IORM B,@X
SOJG ILOOP
JRST DONXT
SOJL A,XONR
XMOVR: REPEAT LBUFL-1,<AOJ X,>
MOVE X,[XD,,LBUFL]
AOJ A,
XONR: MOVSI X,Y
AOJA A,DOPEN
XCHA3: EXCH C,0
SETZ 14,
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
ILOP: ADD 15,C
TLZN 15,200000
JRST DOPE
ROT B,-1
SKIPGE B
XCT XMOOR(X)
DOPE: ADDI Y,LBUFL+1
IORM B,@X
SOJG ILOP
JRST DONXT
SOJL A,XRN
XMOOR: REPEAT LBUFL-1,<AOJ X,>
MOVE X,[XD,,LBUFL]
AOJ A,
XRN: MOVSI X,Y
AOJA A,DOPE
MVLD: MOVMS C
MOVMS 0
CAMLE C,0
JRST XCHA4
SETZ 14,
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
LOOP: ADD 15,C
TLZE 15,200000
SUBI Y,LBUFL+1
ROT B,-1
SKIPGE B
XCT XMVVR(X)
PPEN: IORM B,@X
SOJG LOOP
JRST DONXT
SOJL A,XONE
XMVVR: REPEAT LBUFL-1,<AOJ X,>
MOVE X,[XD,,LBUFL]
AOJ A,
XONE: MOVSI X,Y
AOJA A,PPEN
XCHA4: EXCH C,0
SETZ 14,
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
LOP: ADD 15,C
TLZN 15,200000
JRST DOP
ROT B,-1
SKIPGE B
XCT XOOOR(X)
DOP: SUBI Y,LBUFL+1
IORM B,@X
SOJG LOP
JRST DONXT
SOJL A,XRNM
XOOOR: REPEAT LBUFL-1,<AOJ X,>
MOVE X,[XD,,LBUFL]
AOJ A,
XRNM: MOVSI X,Y
AOJA A,DOP
FNF: PUSHJ P,DETCHK
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ /LOOKUP FAILED.
/
SKIPGE DET
CALLI 12
JRST FILIN
CORLUZ: MOVE T,TT
LSH T,-12
PUSH P,T
PUSHJ P,DETCHK
PUSHJ P,XERR
POP P,T
PUSHJ P,DECOUT
PUSHJ P,ERRPNT
ASCIZ / K OF CORE NEEDED!
/
SKIPGE DET
CALLI 12
JRST ASKLEN
LOSE: SKIPE POOB
JRST LOBAC
SETOM POOB
PUSHJ P,DETCHK
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ /POINT OUT OF BOUNDS, /
CAIGE Y,(L)
JRST [ PUSHJ P,ERRPNT
ASCIZ/-Y/
JRST LOBAC]
PUSHJ P,ERRPNT
ASCIZ/+Y/
JRST LOBAC
DECOUT: IDIVI T,=10
HRLM TT,(P)
SKIPE T
PUSHJ P,DECOUT
HLRZ TT,(P)
ADDI TT,60
ROT TT,-7
MOVEM TT,.+2
PUSHJ P,ERRPNT
0
POPJ P,
ERRPNT: HRRZ TT,(P)
MOVEM TT,PNTR
MOVEI TT,LINE
TTYMES TT,
JRST [ OUTSTR[ASCIZ/TTYMES FAILED /]
OUTSTR @PNTR
OUTSTR[ASCIZ/
/]
JRST .+1]
POP P,TT
HRL TT,(TT)
TLNE TT,376
AOJA TT,.-2
JRST 1(TT)
XERR: PUSHJ P,ERRPNT
ASCIZ/
MESSAGE FROM X WORKING ON /
MOVE TT,FILNAM
PUSHJ P,SIXOUT
PUSHJ P,ERRPNT
ASCIZ/./
HLLZ TT,FILEXT
PUSHJ P,SIXOUT
PUSHJ P,ERRPNT
ASCIZ/[/
MOVE TT,FILPPN
PUSHJ P,SIXOUT
PUSHJ P,ERRPNT
ASCIZ/] : /
POPJ P,
SIXOUT: JUMPE TT,CPOPJ
SETZ T,
LSHC T,6
ADDI T,40
PUSH P,TT
ROT T,-7
MOVEM T,.+2
PUSHJ P,ERRPNT
0
POP P,TT
JRST SIXOUT
DETCHK: SETOM DET#
GETLIN DET
HRRES DET
SKIPL DET
AOS (P)
POPJ P,
FRD: MOVSI A,'DMD'
MOVEM A,FILEXT
PUSHJ P,GETNAM
SKIPN A
MOVE A,['PLT ']
MOVEM A,FILNAM
CAIE C,"."
JRST NOEXT
PUSHJ P,GETNAM
MOVEM A,FILEXT
NOEXT: CAIE C,"["
JRST FRDX
PUSHJ P,GETP
HRLZM A,FILPPN
PUSHJ P,GETP
HRRM A,FILPPN
FRDX: INCHRW C
CAIE C,12
JRST FRDX
POPJ P,
RNUM: INCHWL C
CAIN C,15
JRST RNUM
CAIN C,12
POPJ P,
AOS (P)
MOVEI A,
SETZM SIGN
CAIN C,"-"
JRST [ PUSHJ P,RNUML
SETOM SIGN
MOVN A,A
POPJ P,]
CAIN C,"+"
RNUML: INCHWL C
CAIL C,"0"
CAILE C,"9"
JRST RNUMX
IMULI A,12
ADDI A,-"0"(C)
JRST RNUML
RNUMX: CAIN C,15
INCHRW C
POPJ P,
GETNAM: MOVEI A,
MOVE B,[440600,,A]
GETNML: PUSHJ P,RCH
POPJ P,
SUBI C,40
TLNE B,770000
IDPB C,B
JRST GETNML
GETP: MOVEI A,
GETPL: PUSHJ P,RCH
POPJ P,
TRNE A,770000
JRST GETPL
LSH A,6
ADDI A,-40(C)
JRST GETPL
RCH: INCHWL C
CAIN C,42
JRST RCHQ
CAIE C,11
CAIN C," "
JRST RCH
CAIE C,"."
CAIN C,","
POPJ P,
CAIE C,"["
CAIN C,"]"
POPJ P,
RCHQR: CAIGE C,40
POPJ P,
CAIL C,"a"
CAILE C,"z"
CAIA
SUBI C,40
JRST POPJ1
RCHQ: INCHWL C
JRST RCHQR
XINI: OUTSTR [ASCIZ /TOTAL LENGTH IN INCHES (Y DIMENSION, DEFAULT = 11)?/]
PUSHJ P,RNUM
MOVEI A,=11 ;ASSUME 11 INCHES
JUMPLE A,[XINLER:CLRBFI
JRST XINI]
CAIE C,12
JRST XINLER
IMULI A,=200
PUSH P,A
YINI1: OUTSTR [ASCIZ \ORIGIN Y OFFSET FROM BOTTOM, 200/IN.(DEFAULT IS 100)?\]
PUSHJ P,RNUM
JRST [ MOVEI A,=100
JRST IYDEF]
CAIE C,12
JRST [ CLRBFI
JRST YINI1]
IYDEF: IMULI A,LBUFL+1
MOVEM A,IYPOS#
POP P,A
XDEF: MOVEM A,LINCNT#
MOVEI B,-1(A)
IMULI A,LBUFL+1
MOVE T,JOBFF
MOVEM T,XGPPTR
SOS XGPPTR
MOVEI T,2(A)
MOVNI TT,(T)
ADD T,XGPPTR
HRLM TT,XGPPTR
MOVE TT,T
CALLI T,11
POPJ P,
HRRZ L,XGPPTR
MOVSI T,1(L)
HRRI T,2(L)
SETZM 1(L)
MOVE U,JOBREL
BLT T,(U)
MOVE TT,[BYTE (12)4001,LMAR,LBUFL]
MOVEM TT,1(L) ;FIRST ONE HAS MARK AND CUT WITH IT
TLZ TT,400000 ;DELETE MARK AND CUT
MOVEI T,1+LBUFL+1(L)
XINL: MOVEM TT,(T)
ADDI T,LBUFL+1
SOJG B,XINL
MOVSI TT,400100
MOVEM TT,(T) ;SO DOES LAST
MOVE Y,IYPOS
ADDI Y,2(L)
MOVEI XD,DBUF+1
SKIPL A,INIX ;WHERE DO WE START
JRST MAYBON
SUBI A,43
IDIV A,[-44]
HRLOI X,XD
SOJA A,SETB
MAYBON: ADDI A,43
IDIVI A,44
CAILE A,LBUFL
JRST OFFRT
MOVE X,A
SETZ A,
HRLI X,Y
JRST SETB
OFFRT: MOVE X,[XD,,LBUFL]
SUBI A,LBUFL
SETB: MOVE B,INIX
IDIVI B,44
MOVSI B,400000
MOVN C,C
ROT B,(C)
POPJ1: AOS (P)
CPOPJ: POPJ P,
XGPOUT: OPEN XGP,[1017↔'XGP '↔0]
JRST NOXGP
OUTSTR[ASCIZ/CRANKING XGP
/]
LOCK
OUTIT: OUT XGP,XGPPTR
JRST OUTOK
DSKERR: PUSHJ P,DETCHK
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ /XGP OUTPUT ERROR.
/
OUTOK: UNLOCK
RELEAS XGP,
XMORE: PUSHJ P,CORDWN ;REALLY DONE, CORE DOWN
PUSHJ P,DETCHK
JRST DODEL ;DELETE AUTOMATICALLY IF DETACHED
OUTSTR[ASCIZ/DELETE BIN FILE?/]
INCHRW C
CAIN C,15
INCHRW C
CAIE C,12
OUTSTR[ASCIZ/
/]
CAIE C,"Y"
CAIN C,"y"
CAIA
JRST NODEL
DODEL: MOVE A,[FILNAM,,LKENT]
BLT A,LKENT+3
INIT DSK,17
'DSK '
0
JRST [ SKIPGE DET
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ/COULDN'T GET DISK FOR DELETE!
/
JRST NODEL]
LOOKUP DSK,LKENT
JRST [ SKIPGE DET
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ/LOOKUP FOR DELETE FAILED!
/
JRST NODEL]
MOVE A,FILPPN
MOVEM A,LKENT+3
SETZM LKENT
RENAME DSK,LKENT
CAIA
JRST NODEL
SKIPGE DET
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ/RENAME FOR DELETE FAILED!
/
NODEL: RELEASE DSK,
SKIPGE DET
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ/ALL DONE!
/
CALLI 12 ;LEAVE
NOXGP: PUSHJ P,DETCHK
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ /XGP NOT AVAILABLE (I THOUGHT I WAS WAITING FOR IT)!
/
POPJ P,
XGPPTR: BLOCK 2
IFN LSTBIT-1,<
XFIX: MOVE A,[LSTBIT-1]
MOVE C,LINCNT
HRRZ D,XGPPTR
XFIXL: ANDCAM A,LBUFL-1+2(D)
ADDI D,LBUFL+1
SOJG C,XFIXL
POPJ P,
>
CORDWN: MOVE T,JOBFF
SUBI T,1
CALLI T,11
JRST 4,.
POPJ P,
FILNAM: 0
FILEXT: 0
0
FILPPN: 0
LKENT: BLOCK 4
XGSNAM: 0
XGSEXT: 0
0
XGSPPN: 0
IBUF: BLOCK 3
BITTAB: FOR I←43,0,-1{1⊗I
}
BYTTAB: FOR I←36,0,-6{REPEAT 6,{77⊗I}}
DBUF: BLOCK LBUFL+2
PDL: BLOCK LPDL
END BEG